home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 12 / BBS in a box XII-2.iso / Files II / Prog / A / About... 2.1.sit / About… 2.1 Demo Main.p < prev    next >
Encoding:
Text File  |  1992-01-01  |  30.9 KB  |  938 lines  |  [TEXT/PJMM]
  1. program AboutDemo;                {    Last Update :  1/1/92 }
  2. {}
  3. {   This program demonstrates the About… 2.1 Unit. }
  4. {}
  5. {   About… is copyrighted, and I reserve all rights to it; both source and }
  6. {   compiled versions.  Please do not distribute modified copies without my }
  7. {   permission, or remove this notice.  Thanks. }
  8. {}
  9. {    About is being distributed as $10 shareware. Reigstered users receive a}
  10. {    diskette containing the Think Pascal source for the current version of}
  11. {    About… and may use it and future versions in any program or programs}
  12. {    you write.  You need not credit me for its use.}
  13. {}
  14. {   Jon Wind (About…)}
  15. {   2374 Hillwood Drive}
  16. {   Maplewood, MN  55119}
  17. {}
  18.  
  19.  
  20. { Modal procedure: }
  21. { this routine does everything, returning to calling proc only after the window is dismissed... }
  22. {•    procedure BuildAbout (WinRect: Rect;}
  23. {                            WinProc, TEXTid: Integer;}
  24. {                            WinTitle, WinMsg: Str255;}
  25. {                            WinMisc: AboutRec);}
  26.  
  27.  
  28. { Modeless procedures: }
  29. { returns true if the specified window is an About window; otherwise returns false }
  30. {•    function IsAboutWindow (theWindow: WindowPtr): Boolean;}
  31.  
  32. { open About window and return pointer to it - returns NIL if window is not created }
  33. { Note: you should keep track of this pointer only if you wish to keep specific track of it }
  34. {•    function OpenAbout (WinRect: Rect;}
  35. {                            WinProc, TEXTid: Integer;}
  36. {                               WinTitle, WinMsg: Str255;}
  37. {                            WinMisc: AboutRec): WindowPtr;}
  38.  
  39. { handle event relating to About window, ie updateEvt, activateEvt, mouseDown, keyDown, etc… }
  40. { Note: this proc should be called after every event for each About window for everything to work correctly }
  41. { Note: this proc calls the CloseAbout proc if the OK button is selected }
  42. { Note: you can filter events passed to it to simulate a modal dialog }
  43. {•    procedure HandleAbout (var theWindow: WindowPtr;}
  44. {                            var theEvent: EventRecord);}
  45.  
  46. { close the specified About window, kill data structures associated with it, and set theWindow to NIL… }
  47. { Note: this proc is called by the HandleAbout proc when an About window is dismissed by selecting its OK button }
  48. { Note: this proc should be called when the program needs to remove an About window }
  49. {•    procedure CloseAbout (var theWindow: WindowPtr);}
  50.  
  51.  
  52.     uses
  53.         About,                        { …my unit! }
  54.         Globals,                    { program globals }
  55.         DemoUtils;                { general utils }
  56.  
  57.  
  58.  
  59.  
  60.  
  61.     procedure DoHelp;
  62. { Display modal help dialog - not a lot of code needed... }
  63.         var
  64.             HelpWinRect: Rect;
  65.             SavePort: GrafPtr;
  66.     begin
  67.         GetPort(SavePort);            { save current port }
  68.         SetPort(MainDlgPtr);
  69.         EraseRect(ramRect);        { memory count won't be accurate during modal display, so lose it }
  70.         InvalRect(ramRect);
  71.         with AboutStuff do        { set up the text stuff to be used by the About... unit }
  72.             begin
  73.                 FontInfo[AboutMsg].Font := Geneva;        { use Geneva for Message }
  74.                 FontInfo[AboutMsg].Size := 9;                { use 9 point for Message }
  75.                 FontInfo[AboutMsg].Face := [outline];        { use outline face for Message }
  76.                 FontInfo[AboutMsg].Color := GreenColor;    { use green for Message }
  77.                 FontInfo[AboutTEXT].Font := Monaco;        { use Monaco for TEXT - 'styl' resource may override }
  78.                 FontInfo[AboutTEXT].Size := 9;            { use 9 point for TEXT - 'styl' resource may override }
  79.                 FontInfo[AboutTEXT].Face := [bold];        { use bold face for TEXT - 'styl' resource may override }
  80.                 FontInfo[AboutTEXT].Color := RedColor;    { use red for TEXT - 'styl' resource may override }
  81.                 TEXTCopy := True;                    { allow copy to clipboard }
  82.                 KeyEquivs := True;                    { allow key equivalents }
  83.                 CloseBox := False;                    { set close box Boolean }
  84.                 Styled := True;                        { set use of styled text (if possible) }
  85.                 CenterMode := AboutMainCenter;    { center window }
  86.                 MainIcon := 1000;                    { use icon }
  87.                 ClickIcon := AboutNoIcon;            { no new icon when original is clicked on - use MainIcon if only new message is desired }
  88.                 ClickMsg := '';                        { no click message - no need to define if ClickIcon = AboutNoIcon }
  89.             end;
  90.         SetRect(HelpWinRect, 0, 0, 420, 257);
  91.         BuildAbout(HelpWinRect, dBoxProc, HelpTEXTID, '', CopyrightMsg, AboutStuff);
  92.         SetPort(SavePort);            { save current port }
  93.     end;
  94.  
  95.  
  96.     procedure PutRectVarInDialog;
  97. { put current values into edit text boxes and set buttons }
  98.     begin
  99.         ChangeChoiceText(MainDlgPtr, dTopEd, aNum2Str(zVar.WinRect.top));
  100.         ChangeChoiceText(MainDlgPtr, dLeftEd, aNum2Str(zVar.WinRect.left));
  101.         ChangeChoiceText(MainDlgPtr, dRightEd, aNum2Str(zVar.WinRect.right));
  102.         ChangeChoiceText(MainDlgPtr, dBottomEd, aNum2Str(zVar.WinRect.bottom));
  103.     end; { of proc PutRectVarInDialog }
  104.  
  105.  
  106.     procedure FixCloseCheckbox;
  107.     begin
  108.         if (WinTypePop.Selected = dNoGrowWin) or (WinTypePop.Selected = dRDocWWin) then
  109.             SetCheckOrRadioBtn(MainDlgPtr, dCloseChk, Ord(zVar.Close))    { restore checkbox to actual value }
  110.         else
  111.             begin
  112.                 SetCheckOrRadioBtn(MainDlgPtr, dCloseChk, Off);            { uncheck checkbox - no need to change zClose var though... }
  113.                 SetCheckOrRadioBtn(MainDlgPtr, dCloseChk, Disable);        { disable checkbox }
  114.             end;
  115.     end;{of proc FixCloseCheckbox }
  116.  
  117.  
  118.     procedure PutVarsInDialog;
  119. { put current values into edit text boxes and set buttons }
  120.     begin
  121.         SetCheckOrRadioBtn(MainDlgPtr, dMsgChk, Ord(zVar.Msg));                { set use message text checkbox }
  122.         SetCheckOrRadioBtn(MainDlgPtr, Succ(dCenterRad) + zVar.Center, On);    { set Center Window radio }
  123.         SetCheckOrRadioBtn(MainDlgPtr, dIconChk, Ord(zVar.ShowIcon));        { set Show Icon checkbox }
  124.         SetCheckOrRadioBtn(MainDlgPtr, dStylChk, Ord(zVar.Style));            { set use styled text checkbox }
  125.         SetCheckOrRadioBtn(MainDlgPtr, dCopyChk, Ord(zVar.CopyIt));            { set copy to clipboard checkbox }
  126.         SetCheckOrRadioBtn(MainDlgPtr, dCloseChk, Ord(zVar.Close));            { set close box checkbox }
  127.         SetCheckOrRadioBtn(MainDlgPtr, dEquivChk, Ord(zVar.Keys));            { set key equivalents checkbox }
  128.         PutRectVarInDialog;
  129.         ChangeChoiceText(MainDlgPtr, dTitleEd, zVar.TitleText);
  130.         ChangeChoiceText(MainDlgPtr, dMsgEd, zVar.MsgText);
  131.         SelItext(MainDlgPtr, dTopEd, 0, maxint);
  132.     end; { of proc PutVarsInDialog }
  133.  
  134.  
  135.     procedure DrawFreeRam;
  136. { display current free memory }
  137.         var
  138.             origFont, origSize: Integer;
  139.             SavePort: GrafPtr;
  140.             fontStuff: FontInfo;
  141.             ramStr: Str255;
  142.     begin
  143.         GetPort(SavePort);            { save current port }
  144.         SetPort(MainDlgPtr);
  145.         origFont := MainDlgPtr^.txFont;
  146.         origSize := MainDlgPtr^.txSize;
  147.         ramFree := FreeMem;
  148.         NumToString(ramFree, ramStr);
  149.         EraseRect(ramRect);
  150.         TextSize(9);
  151.         TextFont(Geneva);
  152.         GetFontInfo(fontStuff);
  153.         MoveTo(ramrect.left, ramRect.bottom - fontStuff.descent);
  154.         DrawString(Concat(ramStr, ' bytes free'));
  155.         TextFont(origFont);
  156.         TextSize(origSize);
  157.         SetPort(SavePort);            { restore old port }
  158.     end;  { of proc DrawFreeRam }
  159.  
  160.  
  161.     function GetNextWinHdl: Integer;
  162.         var
  163.             j: SignedByte;
  164.     begin
  165.         GetNextWinHdl := 0;
  166.         for j := 1 to maxDemoWindows do
  167.             if DemoWinPtr[j] = nil then
  168.                 begin
  169.                     GetNextWinHdl := j;
  170.                     leave;
  171.                 end;
  172.     end;  { of func GetNextWinHdl }
  173.  
  174.  
  175.     procedure DemoAbout;
  176.         var
  177.             aWin: SignedByte;
  178.     begin
  179.         case WinTypePop.Selected of
  180.             dBoxWWin: 
  181.                 zVar.WinProc := dBoxProc;
  182.             dPlainWWin: 
  183.                 zVar.WinProc := plainDBox;
  184.             dAltWWin: 
  185.                 zVar.WinProc := altDBoxProc;
  186.             dNoGrowWin: 
  187.                 zVar.WinProc := noGrowDocProc;
  188.             dRDocWWin: 
  189.                 zVar.WinProc := rDocProc;
  190.             dMovableWin: 
  191.                 zVar.WinProc := movableDBoxProc;
  192.         end;
  193.         with AboutStuff do        { set up the text stuff to be used by the About... unit }
  194.             begin
  195.                 FontInfo[AboutMsg].Font := 0;                    { use Chicago for Message }
  196.                 FontInfo[AboutMsg].Size := 0;                    { use 12 point for Message }
  197.                 FontInfo[AboutMsg].Face := [];                    { use normal face for Message }
  198.                 FontInfo[AboutMsg].Color := BlueColor;        { use blue for Message }
  199.                 FontInfo[AboutTEXT].Font := Geneva;            { use Geneva for TEXT - 'styl' resource may override }
  200.                 FontInfo[AboutTEXT].Size := 9;                { use 9 point for TEXT - 'styl' resource may override }
  201.                 FontInfo[AboutTEXT].Face := [];                { use normal face for TEXT - 'styl' resource may override }
  202.                 FontInfo[AboutTEXT].Color := GreenColor;    { use green for TEXT - 'styl' resource may override }
  203.                 TEXTCopy := zVar.CopyIt;                { set copy to clipboard Boolean }
  204.                 KeyEquivs := zVar.Keys;                { set key equivalents Boolean }
  205.  
  206.                 if (zVar.WinProc = plainDBox) and (not zVar.ShowIcon) and ((Length(zVar.MsgText) = 0) or not zVar.Msg) then
  207.                     CloseBox := False                        { force no close box for this condition in this demo }
  208.                 else
  209.                     CloseBox := zVar.Close;                { set close box Boolean }
  210.  
  211.                 Styled := zVar.Style;                    { set use of styled text (if possible) }
  212.                 CenterMode := zVar.Center;            { set center window integer }
  213.                 if zVar.ShowIcon then
  214.                     MainIcon := IconID
  215.                 else        { Note: use contant "AboutNoIcon" to indicate no icon }
  216.                     MainIcon := AboutNoIcon;
  217.                 ClickIcon := IconID + 1;
  218.                 ClickMsg := SharewareMsg;
  219.             end;
  220.         zVar.WinRect.top := aStr2Num(GetEdText(MainDlgPtr, dTopEd));
  221.         zVar.WinRect.left := aStr2Num(GetEdText(MainDlgPtr, dLeftEd));
  222.         zVar.WinRect.right := aStr2Num(GetEdText(MainDlgPtr, dRightEd));
  223.         zVar.WinRect.bottom := aStr2Num(GetEdText(MainDlgPtr, dBottomEd));
  224.         zVar.TitleText := GetEdText(MainDlgPtr, dTitleEd);
  225.         zVar.MsgText := GetEdText(MainDlgPtr, dMsgEd);
  226.  
  227.         PutRectVarInDialog;        { stuff rect values back into text fields }
  228.         SelItext(MainDlgPtr, Succ(DialogPeek(MainDlgPtr)^.editField), 0, 0);                { deselect text }
  229.  
  230. { find first available window pointer in array }
  231.         aWin := GetNextWinHdl;
  232.         if aWin > 0 then
  233.             begin
  234.                 if zVar.Msg then
  235.                     begin
  236.                         if zVar.Modal then
  237.                             begin
  238.                                 BuildAbout(zVar.WinRect, zVar.WinProc, AboutTEXTID, zVar.TitleText, zVar.MsgText, AboutStuff);
  239.                                 Exit(DemoAbout);
  240.                             end
  241.                         else
  242.                             DemoWinPtr[aWin] := OpenAbout(zVar.WinRect, zVar.WinProc, AboutTEXTID, zVar.TitleText, zVar.MsgText, AboutStuff)
  243.                     end
  244.                 else
  245.                     begin
  246.                         if zVar.Modal then
  247.                             begin
  248.                                 BuildAbout(zVar.WinRect, zVar.WinProc, AboutTEXTID, zVar.TitleText, '', AboutStuff);
  249.                                 Exit(DemoAbout);
  250.                             end
  251.                         else
  252.                             DemoWinPtr[aWin] := OpenAbout(zVar.WinRect, zVar.WinProc, AboutTEXTID, zVar.TitleText, '', AboutStuff);
  253.                     end;
  254.  
  255.                 if DemoWinPtr[aWin] <> nil then        { window was built }
  256.                     begin
  257.                         DrawFreeRam;                            { update free memory display }
  258.  
  259.     { Disable OK button if there are no more window handles free }
  260.                         if GetNextWinHdl = 0 then
  261.                             begin
  262.                                 SetCheckOrRadioBtn(MainDlgPtr, OK, Disable);        { disable OK button since all handles are in use }
  263.                                 DrawDefaultBtn(MainDlgPtr, OK);
  264.                             end;
  265.                     end
  266.                 else
  267.                     SysBeep(3);        { window was not built }
  268.             end;
  269.     end;  { of proc DemoAbout }
  270.  
  271.  
  272.     procedure DealwithKeyDowns (var Event: EventRecord);
  273.         var
  274.             j: SignedByte;
  275.             theWindow, origWindow: WindowPtr;
  276.             theKey, FieldInUse, whichItem: Integer;
  277.             TEPeek: DialogPeek;
  278.             CmdKeyUsd: Boolean;
  279.             err: OSErr;
  280.     begin
  281.         theWindow := FrontWindow;
  282.  
  283.         if IsAboutWindow(theWindow) then
  284.             begin
  285.                 origWindow := theWindow;                            { save original window pointer }
  286.                 HandleAbout(theWindow, Event);
  287.                 if theWindow = nil then                            { About window was killed }
  288.                     for j := 1 to maxDemoWindows do                { remove entry window pointer array }
  289.                         if DemoWinPtr[j] = origWindow then
  290.                             begin
  291.                                 DemoWinPtr[j] := nil;
  292.                                 SetCheckOrRadioBtn(MainDlgPtr, OK, Off);            { enable OK button since at least one handle is not in use }
  293.                                 DrawDefaultBtn(MainDlgPtr, OK);
  294.                             end;
  295.             end
  296.         else if (GetWRefCon(theWindow) = AboutDemoID) then
  297.             begin
  298.                 whichItem := 0;
  299.                 TEPeek := DialogPeek(theWindow);
  300.                 FieldInUse := TEPeek^.editField + 1;        { get # of edit field in use }
  301.                 theKey := BitAnd(Event.message, charCodeMask);            { decode char }
  302.                 CmdKeyUsd := (BitAnd(Event.modifiers, cmdKey) <> 0);        { cmd key down? }
  303.                 if (FieldInUse <> dMsgEd) and (theKey = CR) then    { allow CRs in msg text field }
  304.                     theKey := enterKey;
  305.                 case theKey of
  306.                     enterKey:        { OK Button equivalents }
  307.                         begin
  308.                             whichItem := -1;        { hides key }
  309.                             if CtrlEnabled(theWindow, OK) then
  310.                                 begin
  311.                                     FakeClick(theWindow, OK);
  312.                                     DemoAbout;
  313.                                 end;
  314.                         end;
  315.                     lowerC, upperC:         { not needed with System 7.0! }
  316.                         if CmdKeyUsd then
  317.                             begin      { copy selection to clipboard }
  318.                                 DlgCopy(theWindow);
  319.                                 if TEGetScrapLen > 0 then
  320.                                     if ZeroScrap = noErr then
  321.                                         Err := TEtoScrap;
  322.                                 whichItem := -1;        { hides key }
  323.                             end
  324.                         else if FieldInUse <= dBottomEd then
  325.                             whichItem := -1;    { hides non-numeric keys }
  326.                     lowerV, upperV:          { not needed with System 7.0! }
  327.                         if CmdKeyUsd then
  328.                             begin      { paste clipboard }
  329.                                 Err := TEfromScrap;
  330.                                 if TEGetScrapLen > 0 then
  331.                                     DlgPaste(theWindow);
  332.                                 whichItem := -1;        { hides key }
  333.                             end
  334.                         else if FieldInUse <= dBottomEd then
  335.                             whichItem := -1;    { hides non-numeric keys }
  336.                     lowerX, upperX:          { not needed with System 7.0! }
  337.                         if CmdKeyUsd then
  338.                             begin      { cut selection to clipboard }
  339.                                 DlgCut(theWindow);
  340.                                 if TEGetScrapLen > 0 then
  341.                                     if ZeroScrap = noErr then
  342.                                         Err := TEtoScrap;
  343.                                 whichItem := -1;        { hides key }
  344.                             end
  345.                         else if FieldInUse <= dBottomEd then
  346.                             whichItem := -1;    { hides non-numeric keys }
  347.                     downArrow: 
  348.                         if TabSelectText(theWindow, goNext) then
  349.                             whichItem := -1;        { hides key }
  350.                     upArrow: 
  351.                         if TabSelectText(theWindow, goPrev) then
  352.                             whichItem := -1;        { hides key }
  353.                     tabKey: 
  354.                         if BitAnd(Event.modifiers, shiftKey) <> 0 then    { shift key down }
  355.                             if TabSelectText(theWindow, goPrev) then
  356.                                 whichItem := -1;        { hides key }
  357.                     otherwise
  358.                         if FieldInUse <= dBottomEd then
  359.                             if not (theKey in [num0..num9, BS, leftArrow, rightArrow]) then
  360.                                 whichItem := -1;    { hides non-numeric keys }
  361.                 end;
  362.                 if whichItem < 0 then
  363.                     Event.what := 0;      { 'EAT' processed cmd key }
  364.             end;
  365.  
  366.     end; { of proc DealwithKeyDowns }
  367.  
  368.  
  369.     function GetGrayRgn: RgnHandle;
  370. { get gray region }
  371.         var
  372.             thePtr: ^RgnHandle;
  373.     begin
  374.         thePtr := Pointer($9EE);
  375.         GetGrayRgn := thePtr^;
  376.     end;  { of func GetGrayRgn }
  377.  
  378.  
  379.     procedure rotateByte (p: Ptr);
  380.     inline
  381.         $205F, $1010, $E218, $1080;
  382. {        move.l  (sp)+,a0}
  383. {        move.b  (a0),d0}
  384. {        ror.b   #1,d0}
  385. {        move.b  d0,(a0)}
  386.  
  387.  
  388.     procedure HandleSetRect (theDialog: DialogPtr);
  389. { deal with set rect for sample window }
  390.         var
  391.             j, itmType, winKind, totItems, height, width: Integer;
  392.             startPt, endPt: Point;
  393.             oldRect, titleRect, theRect: Rect;
  394.             deskPort: GrafPtr;
  395.             mouseEvent: EventRecord;
  396.             itmHdl: Handle;
  397.             rgnHdl: RgnHandle;
  398.             IntPtr: ^Integer;
  399.             marqueePat: Pattern;
  400.             lastDraw: LongInt;
  401.             theString: Str255;
  402.             done: Boolean;
  403.             Wind: WindowPtr;
  404.  
  405.         procedure DrawMarquee (oldRect, newRect: Rect);
  406.             var
  407.                 i: Integer;
  408.         begin
  409.             lastDraw := TickCount;
  410.             for i := 0 to 7 do                    { set up blinking marquee pattern by shifting bits }
  411.                 rotateByte(@marqueePat[i]);
  412.             FrameRect(oldRect);                { erase old rect }
  413.             PenPat(marqueePat);
  414.             FrameRect(newRect);                { draw new rect }
  415.         end;  { of proc DrawMarquee }
  416.  
  417.     begin
  418.         SelItext(theDialog, Succ(DialogPeek(theDialog)^.editField), 0, 0);                { deselect text }
  419.  
  420.         IntPtr := Pointer(DialogPeek(theDialog)^.Items^);
  421.         totItems := Succ(IntPtr^);        { total # of items in dialog }
  422.  
  423.         PenPat(gray);
  424.         PenMode(patBic);                    { to gray existing text... }
  425.         PaintRect(theDialog^.portRect);        { "gray out" text }
  426.         PenNormal;
  427.  
  428.         SetBtnTitle(theDialog, dSetRectBtn, dSetRectBtnStr2);    { change btn title to help user & force btn redraw }
  429.         for j := 1 to 4 do                                        { redraw rect coordinates so they're not gray }
  430.             begin
  431.                 GetDItem(theDialog, (Pred(j) * 2) + dTopEd, itmType, itmHdl, oldRect);    { get button location }
  432.                 GetIText(itmHdl, theString);
  433.                 SetIText(itmHdl, theString);
  434.             end;
  435.         GetWTitle(theDialog, theString);
  436.         SetWTitle(theDialog, 'Click and Drag or Press a Key to Cancel');
  437.  
  438. { setup rect to use to gray title bar - bad idea since it may not work with alternate WDEFs...}
  439.         titleRect := theDialog^.portRect;
  440.         LocalToGlobal(titleRect.topLeft);
  441.         LocalToGlobal(titleRect.botRight);
  442.         OffsetRect(titleRect, 0, -18);
  443.         titleRect.bottom := titleRect.top + 16;
  444.  
  445.         GetDItem(theDialog, dSetRectBtn, itmType, itmHdl, oldRect);    { get button location }
  446.         LocalToGlobal(oldRect.topLeft);
  447.         LocalToGlobal(oldRect.botRight);
  448.  
  449.         New(deskPort);
  450.         OpenPort(deskPort);            { make grafport so can draw on screen }
  451.         UnionRgn(GetGrayRgn, deskPort^.visRgn, deskPort^.visRgn);        { add all monitors to visRgn of new grafPort }
  452.  
  453.     { here I remove the "Set" button from the clip region since I'll be changing its title and this }
  454.     { eliminates the possibility of gray line artifacts left from using the notPatXOr drawing mode }
  455.     { ...trust me... }
  456.         rgnHdl := NewRgn;
  457.         OpenRgn;
  458.         FrameRoundRect(oldRect, 16, 16);         { create button size region to remove from new grafPort }
  459.         CloseRgn(rgnHdl);
  460.         DiffRgn(deskPort^.clipRgn, rgnHdl, deskPort^.clipRgn);    { remove button from clip region }
  461.         DisposeRgn(rgnHdl);
  462.  
  463.         StuffHex(@marqueePat, '0F1E3C78F0E1C387');
  464.         lastDraw := 0;
  465.         oldRect := zVar.WinRect;
  466.  
  467.         PenMode(notPatXor);            { allows easy redrawing of gray frames }
  468.         SetCursor(CrossCurs^^);        { bring up cross cursor }
  469.  
  470.     { create a dBoxProc dialog beyond the edge of the screen under the menu bar to stop MF switching }
  471.         SetRect(theRect, 0, 0, 5, 5);
  472.         wind := NewWindow(nil, theRect, '', True, dBoxProc, Pointer(-1), False, 0);
  473.  
  474.         repeat
  475.             if (TickCount > lastDraw + 1) then
  476.                 DrawMarquee(oldRect, oldRect);
  477.             done := GetNextEvent(mDownMask + keyDownMask, mouseEvent);
  478.         until done;        { wait for mousedown }
  479.         FrameRect(oldRect);        { erase old rect }
  480.         PenPat(gray);
  481.  
  482.     { kill hidden dialog }
  483.         DisposeWindow(wind);
  484.  
  485.         if mouseEvent.what = mouseDown then        { key stroke allows rect to be unchanged }
  486.             begin
  487.                 PenMode(patBic);
  488.                 PaintRect(titleRect);            { gray title bar - bad idea since it may not work with alternate WDEFs...}
  489.                 PenMode(notPatXor);        { allows easy redrawing of gray frames }
  490.  
  491.                 SetRect(oldRect, 0, 0, 0, 0);
  492.                 zVar.WinRect := oldRect;
  493.                 startPt := mouseEvent.where;        { globals are OK }
  494.  
  495.                 repeat                            { repeat until mouse button is released }
  496.                     GetMouse(endPt);
  497.  
  498.                     if (endPt.h > startPt.h) and (endPt.v > startPt.v) then
  499.                         SetRect(zVar.WinRect, startPt.h, startPt.v, endPt.h, endPt.v)
  500.                     else if (endPt.h > startPt.h) and (endPt.v < startPt.v) then
  501.                         SetRect(zVar.WinRect, startPt.h, endPt.v, endPt.h, startPt.v)
  502.                     else if (endPt.h < startPt.h) and (endPt.v > startPt.v) then
  503.                         SetRect(zVar.WinRect, endPt.h, startPt.v, startPt.h, endPt.v)
  504.                     else
  505.                         SetRect(zVar.WinRect, endPt.h, endPt.v, startPt.h, startPt.v);
  506.  
  507.                     if ShiftDown then                    { constrain rect to size of shortest side }
  508.                         with zVar.WinRect do
  509.                             begin
  510.                                 height := bottom - top;
  511.                                 width := right - left;
  512.                                 if width > height then
  513.                                     if startPt.h = left then        { height < width }
  514.                                         right := left + height
  515.                                     else
  516.                                         left := right - height
  517.                                 else if startPt.v = top then    { width < height }
  518.                                     bottom := top + width
  519.                                 else
  520.                                     top := bottom - width
  521.                             end;
  522.  
  523.                     if (zVar.WinRect.right - zVar.WinRect.left >= 150) and (zVar.WinRect.bottom - zVar.WinRect.top >= 100) then
  524.                         SetBtnTitle(theDialog, dSetRectBtn, dSetRectBtnStr3)        { change btn title to help user }
  525.                     else
  526.                         SetBtnTitle(theDialog, dSetRectBtn, dSetRectBtnStr4);    { change btn title to help user }
  527.  
  528.                     if not EqualRect(oldRect, zVar.WinRect) then { update for new rect }
  529.                         begin
  530.                             PutRectVarInDialog;            { update window rect display }
  531.                             DrawMarquee(oldRect, zVar.WinRect);
  532.                             oldRect := zVar.WinRect;        { save current rect for later erasure }
  533.                         end;
  534.  
  535.                     if (TickCount > lastDraw + 1) then
  536.                         DrawMarquee(oldRect, oldRect);
  537.                 until not stilldown;
  538.  
  539.                 FrameRect(oldRect);        { erase last rect }
  540.             end;{ of mouseEvent.what = mouseDown }
  541.  
  542.         PenNormal;
  543.         InitCursor;                    { restore arrow cursor }
  544.         SetBtnTitle(theDialog, dSetRectBtn, dSetRectBtnStr);    { restore btn title }
  545.         ClosePort(deskPort);        { done with port - get rid of it }
  546.         Dispose(deskPort);
  547.         SetPort(theDialog);        { be sure main window is current window }
  548.  
  549.         SetWTitle(theDialog, theString);
  550.         InvalRect(theDialog^.portRect);
  551.     end;  { of proc HandleSetRect }
  552.  
  553.  
  554.     procedure DealwithDialogs (Event: EventRecord);
  555.         var
  556.             dlgPtr: DialogPtr;
  557.             itemHit, j, itmType, winKind, totItems: Integer;
  558.             err: OSErr;
  559.             ItemWasHit, fix: Boolean;
  560.     begin
  561.         case Event.what of
  562.             keydown, autokey: 
  563.                 begin
  564.                     DealwithKeyDowns(Event);
  565.                     if ((Event.what = keydown) | (Event.what = autokey)) & (DialogSelect(Event, dlgPtr, ItemHit)) then
  566.                         ;        { if Event was not altered by DealwithKeyDowns, pass key along to dialog manager }
  567.                 end;
  568.             ActivateEvt: 
  569.                 if GetWRefCon(WindowPtr(Event.message)) = AboutDemoID then
  570.                     DrawDefaultBtn(WindowPtr(Event.message), OK);
  571.             UpdateEvt: 
  572.                 if GetWRefCon(WindowPtr(Event.message)) = AboutDemoID then
  573.                     begin
  574.                         BeginUpdate(MainDlgPtr);            { this method preserves the window's custom background color - if any }
  575.  
  576.                         FixWindowColor(MainDlgPtr);
  577.                         DrawDialog(MainDlgPtr);
  578.                         EndUpdate(MainDlgPtr);
  579.  
  580.                         UpdatePopUp(WindowPtr(Event.message), WinTypePop);
  581.                         DrawFreeRam;                        { update free memory display }
  582.                     end;
  583.             otherwise
  584.                 if DialogSelect(Event, dlgPtr, ItemHit) & (GetWRefCon(dlgPtr) = AboutDemoID) then
  585.                     begin
  586.                         SetPort(dlgPtr);
  587.                         case itemHit of
  588.                             OK: 
  589.                                 DemoAbout;
  590.                             Cancel: 
  591.                                 Finished := True;
  592.                             dSetRectBtn:    { Set window rect }
  593.                                 HandleSetRect(dlgPtr);
  594.                             dWinProcPop: 
  595.                                 if HandlePopUpSelect(dlgPtr, WinTypePop) then
  596.                                     begin
  597.                                         UpdatePopUp(MainDlgPtr, WinTypePop);
  598.                                         FixCloseCheckbox;
  599.                                     end;
  600.                             dMsgChk: 
  601.                                 begin
  602.                                     zVar.Msg := not zVar.Msg;
  603.                                     SetCheckOrRadioBtn(dlgPtr, itemHit, Ord(zVar.Msg));
  604.                                 end;
  605.                             dCenterRad..dMainMonRad: 
  606.                                 begin
  607.                                     ItemWasHit := ((itemHit - Succ(dCenterRad) = zVar.Center) & (TickCount - lastClick < GetDblTime));
  608.                                     SetCheckOrRadioBtn(MainDlgPtr, Succ(dCenterRad) + zVar.Center, Off);        { set Center Window radio }
  609.                                     zVar.Center := itemHit - Succ(dCenterRad);
  610.                                     SetCheckOrRadioBtn(MainDlgPtr, Succ(dCenterRad) + zVar.Center, On);            { set Center Window radio }
  611.                                     if ItemWasHit then
  612.                                         err := PostEvent(keyDown, enterKey);
  613.                                     lastClick := TickCount;
  614.                                 end;
  615.                             dIconChk: 
  616.                                 begin
  617.                                     zVar.ShowIcon := not zVar.ShowIcon;
  618.                                     SetCheckOrRadioBtn(dlgPtr, itemHit, Ord(zVar.ShowIcon));
  619.                                 end;
  620.                             dStylChk: 
  621.                                 begin
  622.                                     zVar.Style := not zVar.Style;
  623.                                     SetCheckOrRadioBtn(dlgPtr, itemHit, Ord(zVar.Style));
  624.                                 end;
  625.                             dCopyChk: 
  626.                                 begin
  627.                                     zVar.CopyIt := not zVar.CopyIt;
  628.                                     SetCheckOrRadioBtn(dlgPtr, itemHit, Ord(zVar.CopyIt));
  629.                                 end;
  630.                             dCloseChk: 
  631.                                 begin
  632.                                     zVar.Close := not zVar.Close;
  633.                                     SetCheckOrRadioBtn(dlgPtr, itemHit, Ord(zVar.Close));
  634.                                 end;
  635.                             dEquivChk: 
  636.                                 begin
  637.                                     zVar.Keys := not zVar.Keys;
  638.                                     SetCheckOrRadioBtn(dlgPtr, itemHit, Ord(zVar.Keys));
  639.                                 end;
  640.                             dModalChk: 
  641.                                 begin
  642.                                     zVar.Modal := not zVar.Modal;
  643.                                     SetCheckOrRadioBtn(dlgPtr, itemHit, Ord(zVar.Modal));
  644.                                 end;
  645.                             dAboutBtn:    { ? button }
  646.                                 DoHelp;
  647.                             otherwise
  648.                         end;
  649.                     end;
  650.         end;
  651.     end; { of proc DealwithDialogs }
  652.  
  653.  
  654.     procedure DealwithMouseDowns (Event: EventRecord);
  655.         var
  656.             j: SignedByte;
  657.             WindowPointedTo, theWindow: WindowPtr;
  658.             MouseLoc: Point;
  659.             WindoLoc: integer;
  660.     begin
  661.         MouseLoc := Event.Where;
  662.         WindoLoc := FindWindow(MouseLoc, WindowPointedTo);
  663.         if IsAboutWindow(WindowPointedTo) then
  664.             begin
  665.                 theWindow := WindowPointedTo;                    { save original window pointer }
  666.                 HandleAbout(WindowPointedTo, Event);
  667.                 if WindowPointedTo = nil then                    { About window was killed }
  668.                     for j := 1 to maxDemoWindows do                { remove entry from window pointer array }
  669.                         if DemoWinPtr[j] = theWindow then
  670.                             begin
  671.                                 DemoWinPtr[j] := nil;
  672.                                 SetCheckOrRadioBtn(MainDlgPtr, OK, Off);        { enable button }
  673.                                 DrawDefaultBtn(MainDlgPtr, OK);
  674.                             end;
  675.             end
  676.         else
  677.             begin
  678.                 case WindoLoc of
  679.  
  680.                     inMenuBar: 
  681.                         ;
  682.  
  683.                     inSysWindow: 
  684.                         ;
  685.  
  686.                     inContent: 
  687.                         if WindowPointedTo <> FrontWindow then
  688.                             begin
  689.                                 SelectWindow(WindowPointedTo);            { bring to front }
  690.                                 while WindowPointedTo <> nil do
  691.                                     begin
  692.                                         HandleAbout(WindowPointedTo, Event);        { pass event to About Unit }
  693.                                         WindowPointedTo := WindowPtr(WindowPeek(WindowPointedTo)^.nextWindow);
  694.                                     end;
  695.                             end
  696.                         else
  697.                             begin {do something}
  698.                                 sysbeep(1);
  699.                             end;
  700.  
  701.                     inGrow: 
  702.                         ;
  703.  
  704.                     InDrag:            { click in drag bar }
  705.                         begin
  706.                             DragWindow(WindowPointedTo, MouseLoc, ScreenBits.bounds);
  707.                         end;
  708.  
  709.                     inGoAway: 
  710.                         if TrackGoAway(WindowPointedTo, MouseLoc) then
  711.                             DisposeWindow(WindowPointedTo); {since W mgr allocated space}
  712.  
  713.                     otherwise
  714.                 end;{ of case}
  715.             end;
  716.     end; { of proc DealwithMouseDowns }
  717.  
  718.  
  719.     procedure DealwithActivates (Event: EventRecord);
  720.         var
  721.             TargetWindow: WindowPtr;
  722.     begin
  723.         TargetWindow := WindowPtr(Event.message);
  724.  
  725.         if IsAboutWindow(TargetWindow) then
  726.             HandleAbout(TargetWindow, Event)
  727.         else
  728.             begin
  729.                 if Odd(Event.modifiers) then {then the window is becoming active}
  730.                     begin
  731.                         SetPort(TargetWindow);
  732.        {and activate whatever else you need}
  733.        {the scroll bars}
  734.        {hilite selected text}
  735.                     end
  736.                 else
  737.                     begin
  738.        {deactivate whatever you need}
  739.        {deactivate the scroll bars}
  740.        {UNhilite selected text}
  741.                     end;
  742.             end;
  743.     end; { of proc DealwithActivates }
  744.  
  745.  
  746.     procedure DealwithUpdates (Event: EventRecord);
  747.         var
  748.             UpDateWindow: WindowPtr;
  749.     begin
  750.         UpdateWindow := WindowPtr(Event.message);
  751.         if IsAboutWindow(UpdateWindow) then
  752.             HandleAbout(UpdateWindow, Event)
  753.         else
  754.             begin
  755.                 SetPort(UpdateWindow);      {set the port to one in Evt.msg}
  756.                 BeginUpDate(UpdateWindow);
  757.                 DrawDialog(UpdateWindow);
  758.                 EndUpDate(UpdateWindow);
  759.             end;
  760.     end; { of proc DealwithUpdates }
  761.  
  762.  
  763.     procedure MainEventLoop;
  764.         var
  765.             Event: EventRecord;
  766.             ProcessIt: Boolean;
  767.             NextWinPeek, WinPeek: WindowPeek;
  768.     begin
  769.         repeat
  770.             PurgeMem(ramDemand);
  771.             if (ramFree <> FreeMem) then
  772.                 DrawFreeRam;                        { update free memory display }
  773.  
  774.             SystemTask;             {so you can support Desk Accessories}
  775.             ProcessIt := GetNextEvent(EveryEvent, Event);
  776.  
  777.             if IsDialogEvent(Event) then
  778.                 DealwithDialogs(Event)
  779.             else if ProcessIt then{is true}
  780.                 case Event.what of
  781.  
  782.                     mouseDown: 
  783.                         DealwithMouseDowns(Event);
  784.                     keydown, autokey: 
  785.                         DealwithKeyDowns(Event);
  786.                     ActivateEvt: 
  787.                         DealwithActivates(Event);
  788.                     UpDateEvt: 
  789.                         DealwithUpdates(Event);
  790.  
  791.                     otherwise
  792.                 end;{of Case}
  793.         until Finished; {terminate the program}
  794.  
  795.  
  796. { destroy any open About windows… }
  797.         WinPeek := WindowPeek(FrontWindow);
  798.         while WinPeek <> nil do
  799.             begin
  800.                 NextWinPeek := WinPeek^.nextWindow;    { if it's window is an About window, it's history - save next window pointer }
  801.                 if IsAboutWindow(WindowPtr(WinPeek)) then    { is it an About window? }
  802.                     begin
  803.                         CloseAbout(WindowPtr(WinPeek));                { then kill it…}
  804.                         DrawFreeRam;                                        { update free memory display }
  805.                     end;
  806.                 WinPeek := NextWinPeek;
  807.             end;
  808.  
  809. { finally, destroy main dialog }
  810.         DisposDialog(MainDlgPtr);
  811.  
  812. { release menu too… - not strictly necessary for this demo }
  813.         ReleaseResource(Handle(WinTypePop.MenuHndl));
  814.     end; { of proc MainEventLoop }
  815.  
  816.  
  817.     function OpenColorDlg (dlgID: Integer): DialogPtr;
  818. { open regular B&W or color dialog - allows for accurate display of custom content color }
  819.         var
  820.             hasColor: Boolean;
  821.             theWorld: SysEnvRec;
  822.             dlgPtr: DialogPtr;
  823.             aRect: Rect;
  824.             DITLhndl: Handle;
  825.             WinTitle: Str255;
  826.             procID: Integer;
  827.     begin
  828.         if (SysEnvirons(1, theWorld) <> envNotPresent) then    { SysEnvirons call is available }
  829.             hasColor := theWorld.hasColorQD        { has Color QuickDraw }
  830.         else
  831.             hasColor := False;
  832.  
  833.         if hasColor then
  834.             begin
  835.                 dlgPtr := getNewDialog(dlgID, nil, Pointer(-1));    { get dialog box }
  836.                 aRect := dlgPtr^.portRect;
  837.                 GetWTitle(dlgPtr, WinTitle);
  838.                 procID := GetWVariant(dlgPtr);        { GetWVariant func requires MacPlus or better }
  839.                 DisposDialog(dlgPtr);
  840.  
  841.                 DITLhndl := Get1Resource('DITL', dlgID);
  842.                 dlgPtr := NewCDialog(nil, aRect, WinTitle, False, procID, WindowPtr(nil), False, 0, DITLhndl);
  843.             end
  844.         else
  845.             dlgPtr := getNewDialog(dlgID, nil, Pointer(-1));    { get B&W dialog box }
  846.  
  847.         OpenColorDlg := dlgPtr;
  848.     end;  { of func OpenColorDlg }
  849.  
  850.  
  851.     procedure Initialize;
  852.         var
  853.             j: SignedByte;
  854.             theRect: Rect;
  855.             aHdl: Handle;
  856.             height, theItem: Integer;
  857.             fontStuff: FontInfo;
  858.     begin
  859.         CrossCurs := GetCursor(crosscursor);    { read in from system resource }
  860.         HLock(Handle(CrossCurs));                    { lock the handle down }
  861.  
  862.         for j := 1 to maxDemoWindows do
  863.             DemoWinPtr[j] := nil;
  864.  
  865.         Finished := False;
  866.         zVar.Center := AboutNoCenter;
  867.         zVar.Msg := True;
  868.         zVar.ShowIcon := True;
  869.         zVar.Style := True;
  870.         zVar.CopyIt := True;
  871.         zVar.Close := True;
  872.         zVar.Keys := True;
  873.         zVar.Modal := False;
  874.         zVar.MsgText := Concat(AboutVersion, ' Unit', chr(CR), CopyrightMsg);
  875.         zVar.TitleText := Concat(AboutVersion, ' Demo');
  876.         SetRect(zVar.WinRect, 22, 42, 432, 291);        { set default window rect }
  877.  
  878.         lastClick := TickCount;
  879.         SetRect(ramRect, 1, 0, 120, 10);
  880.         ramDemand := maxint * 10;
  881.         ramFree := 0;
  882.  
  883.         WinTypePop.MenuHndl := GetMenu(WinProcMenuID);
  884.         WinTypePop.Selected := dBoxWWin;
  885.         WinTypePop.PopDItem := dWinProcPop;
  886.         WinTypePop.canInvert := True;
  887.  
  888.         MainDlgPtr := OpenColorDlg(AboutDemoID);
  889.         SetWRefCon(MainDlgPtr, AboutDemoID);        { store ID for use in distinguishing window later… }
  890.  
  891. { setup dialog item, popup menu, and popup menu record with correct values }
  892.         GetDItem(MainDlgPtr, Pred(WinTypePop.PopDItem), theItem, aHdl, WinTypePop.promptRect);    { get item's rect }
  893.         GetDItem(MainDlgPtr, WinTypePop.PopDItem, theItem, aHdl, WinTypePop.PopUpRect);            { get item's rect }
  894.  
  895.         with WinTypePop do
  896.             begin
  897.     { limit width of popup menu item - reduce as needed }
  898.                 CalcMenuSize(MenuHndl);
  899.                 if PopUpRect.right > PopUpRect.left + MenuHndl^^.menuWidth then
  900.                     begin
  901.                         GetDItem(MainDlgPtr, PopDItem, theItem, aHdl, PopUpRect);            { get item's rect }
  902.                         PopUpRect.right := PopUpRect.left + MenuHndl^^.menuWidth;
  903.                         SetDItem(MainDlgPtr, PopDItem, theItem, aHdl, PopUpRect);
  904.                     end;
  905.  
  906.     { adjust height of popup menu item - enlarge or reduce as needed }
  907.                 GetFontInfo(fontStuff);
  908.                 height := (fontStuff.ascent + fontStuff.descent + 2);
  909.                 if (PopUpRect.bottom - PopUpRect.top < 18) | (PopUpRect.bottom - PopUpRect.top < height) then { 18 = min for SICNs }
  910.                     begin
  911.                         GetDItem(MainDlgPtr, PopDItem, theItem, aHdl, PopUpRect);            { get item's rect }
  912.                         SetRect(theRect, PopUpRect.left, PopUpRect.top, PopUpRect.right, PopUpRect.top + height);
  913.                         VertCenterRect(theRect, PopUpRect);
  914.                         PopUpRect := theRect;
  915.                         SetDItem(MainDlgPtr, PopDItem, theItem, aHdl, PopUpRect);
  916.                     end;
  917.             end;
  918.  
  919.         InsertMenu(WinTypePop.MenuHndl, hierMenu); { insert as popup/hierarchical }
  920.  
  921. { let Dialog Manager draw RoundRect around default btn }
  922.         SetRect(theRect, 0, 0, 0, 0);
  923.         SetDItem(MainDlgPtr, 3, userItem, @DrawDefaultBtn, theRect);
  924.  
  925.         CenterWindow(MainDlgPtr);                    { center,display,set port,default btn }
  926.         PutVarsInDialog;                                    { put window rect values into edit text boxes }
  927.         FixCloseCheckbox;
  928.  
  929.         InitCursor;
  930.     end;  { of proc Initialize }
  931.  
  932.  
  933. {main program loop}
  934.  
  935. begin
  936.     Initialize;
  937.     MainEventLoop;
  938. end.